home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / em3270.zip / EMDEMO.PAS < prev   
Pascal/Delphi Source File  |  1986-07-22  |  22KB  |  741 lines
  1. (*******************************************************************)
  2. (*                                                                 *)
  3. (*   This program demonstrates some of the capabilities of EM3270  *)
  4. (*   a set of Turbo Pascal procedures for screen handling pat-     *)
  5. (*   terned after the IBM 3270 family of terminals.                *)
  6. (*                                                                 *)
  7. (*   The routines are Copyrighted (C) 1984-1986 by Piedmont        *)
  8. (*   Specialty Software, P. O. Box 6637, Macon, GA 31208, and      *)
  9. (*   are distributed as "user supported software", also called     *)
  10. (*   "shareware". You are free to copy, distribute, and use these  *)
  11. (*   procedures as long as you do not change them or use them in   *)
  12. (*   any commercial software product; that is, any program you     *)
  13. (*   sell to someone else. If you find these routines useful, a    *)
  14. (*   contribution of $20.00, payable to Piedmont Specialty Soft-   *)
  15. (*   ware at the above address, would be in order and appreciated  *)
  16. (*                                                                 *)
  17. (*   Commercial licenses for the use of EM3270 are available.      *)
  18. (*   Contact PSS at the above address, or call (912) 474-2318      *)
  19. (*   for details.                                                  *)
  20. (*                                                                 *)
  21. (*   THIS PROGRAM REQUIRES TURBO PASCAL VERSION 3 TO COMPILE.      *)
  22. (*       EM3270 COMPILES PROPERLY UNDER VERSION 2 OR 3             *)
  23. (*                                                                 *)
  24. (*******************************************************************)
  25.  
  26.  
  27.  
  28.  
  29. Program EMDEMO;
  30.  
  31. {$V-}               (*  <--- ABSOLUTELY NECESSARY!!!   *)
  32.  
  33. Const
  34.   MaxFields = 96;   (*  <--- ABSOLUTELY NECESSARY!!!   *)
  35.  
  36. {$I EM3270.INC}
  37.  
  38. Type
  39.   VRec = Record
  40.          Name   : String[25];
  41.          Addr1  : String[35];
  42.          Addr2  : String[35];
  43.          City   : String[20];
  44.          State  : String[2];
  45.          ZIP    : String[5];
  46.          End;
  47.  
  48.   FRec = Record
  49.          Memb  : String[5];
  50.          Name  : String[25];
  51.          BDM   : String[2];
  52.          BDD   : String[2];
  53.          BDY   : String[2];
  54.          DJM   : String[2];
  55.          DJD   : String[2];
  56.          DJY   : String[2];
  57.          Stat  : String[1];
  58.          BPAC  : String[3];
  59.          BPEX  : String[3];
  60.          BPNU  : String[4];
  61.          BPX   : String[4];
  62.          HPAC  : String[3];
  63.          HPEX  : String[3];
  64.          HPNU  : String[4];
  65.          Addr1 : String[35];
  66.          Addr2 : String[35];
  67.          City  : String[20];
  68.          State : String[2];
  69.          ZIP   : String[5];
  70.          End;
  71.  
  72. Const
  73.   Spaces : String[35] = '                                   ';
  74.  
  75. Var
  76.   FK     : AID;         (*  Must have at least one var of type AID  *)
  77.   Attr   : Byte;
  78.   VRcd   : Vrec;
  79.   FRcd   : Array[1..10] of FRec;
  80.   Mem,
  81.   LastM  : Integer;
  82.  
  83.  
  84.           (************************)
  85.           (*  The WELCOME Screen  *)
  86.           (************************)
  87.  
  88. Procedure WelcomeScreen;
  89.  
  90. Const
  91.   Please : String[27] = 'PLEASE ENTER YOUR PASSWORD:';
  92.  
  93. Var
  94.   Password : String[8];
  95.  
  96. Begin
  97. NewScreen;          (* Clear screen and heap *)
  98.  
  99.           (*  Write the prompts to the screen  *)
  100.  
  101. WritePrompt (23,1,Dim,35,'WELCOME TO THE EM3270 DEMONSTRATION');
  102. WritePrompt (1,3,Dim,79,
  103. 'EM3270 is a collection of TURBO PASCAL procedures providing full screen editing');
  104. WritePrompt (1,4,Dim,75,
  105. 'facilities patterned after the IBM 3270 family of terminals. The "PASSWORD"');
  106. WritePrompt (1,5,Dim,78,
  107. 'data entry field below is an example of an INVISIBLE field. If you press ENTER');
  108. WritePrompt (1,6,Dim,78,
  109. 'without keying any data into it, you will see an example of a BLINK attribute,');
  110. WritePrompt (1,7,Dim,78,
  111. 'an effective edit error highlighting technique. Next key a password (anything)');
  112. WritePrompt (1,8,Dim,78,
  113. 'and notice the effect of the INVISIBLE attribute as you key. Press ENTER after');
  114. WritePrompt (1,9,Dim,75,
  115. 'keying the password and see it echoed to the screen - proving that the data');
  116. WritePrompt (1,10,Dim,57,
  117. 'from an INVISIBLE field is really available to a program.');
  118. WritePrompt (11,13,Dim,27,Please);
  119.  
  120.           (*  Initialize the data field (bright, invisible)  *)
  121.  
  122. WriteField (39,13,Invisible,8,' ');
  123.  
  124.           (* Put Cursor in field 1 and get data  *)
  125.  
  126. Repeat
  127.   ReadScreen (1,FK);
  128. Until FK in [Enter,Escape];
  129. If FK = Escape then Exit;
  130.  
  131.           (*  Retrieve the entered data  *)
  132.  
  133. GetField (1,Password,Attr);
  134. While Password = '        ' do
  135.   Begin
  136.   WritePrompt (11,13,Dim+Blinking,27,Please);
  137.   Repeat
  138.     ReadScreen (1,FK);
  139.   Until FK in [Enter,Escape];
  140.   If FK = Escape then Exit;
  141.   GetField (1,Password,Attr);
  142.   End;
  143.  
  144.           (*  Display the entered password  *)
  145.  
  146. GotoXY (11,15);     (* Note that normal TURBO screen output  *)
  147. SetVid (Dim);       (* can be intermixed with EM3270 I/O     *)
  148. Write ('The password you entered was ',Password);
  149. WritePrompt (11,17,0,41,'Press ENTER to continue; Esc to terminate');
  150.  
  151. Repeat ReadScreen (1,FK) until FK in [Enter,Escape];
  152.  
  153. End;      (*  of WelcomeScreen procedure  *)
  154.  
  155.          (**************)
  156.          (*  Screen 2  *)
  157.          (**************)
  158.  
  159. Procedure Screen2;
  160.  
  161. Begin
  162.  
  163.           (*  Set the default colors  *)
  164.  
  165. BrightBG := Red;
  166. BrightFG := Yellow;
  167. DimBG := Blue;
  168. DimFG := White;
  169.  
  170. NewScreen;          (*  Clear the screen and heap  *)
  171.  
  172.           (*  Display all the prompts  *)
  173.  
  174. WritePrompt (1,1,Dim,79,
  175. 'There are four data entry fields at the bottom of this screen. Two are "bright"');
  176. WritePrompt (1,2,Dim,77,
  177. 'and two are "dim". If you are running this program with a color monitor, dim');
  178. WritePrompt (1,3,Dim,78,
  179. 'fields are white on blue and bright fields are yellow on red. The default col-');
  180. WritePrompt (1,4,Dim,78,
  181. 'ors are controlled by the BYTE variables BrightBG, BrightFG, DimBG, and DimFG.');
  182. WritePrompt (1,5,Dim,76,
  183. 'The foreground (letter) colors can also be controlled on an individual field');
  184. WritePrompt (1,6,Dim,36,'basis through the use of attributes.');
  185. WritePrompt (38,6,0,24,'This is a bright prompt.');
  186. WritePrompt (63,6,Dim,17,'All other prompts');
  187. WritePrompt (1,7,Dim,8,'are dim.');
  188. WritePrompt (10,7,Dim+Cyan,47,'This is a dim prompt with an attribute of CYAN.');
  189. WritePrompt (58,7,Dim,19,'If you have a mono-');
  190. WritePrompt (1,8,Dim,75,
  191. 'chrome monitor, dim is white on black and bright is inverse video (always).');
  192. WritePrompt (1,10,Dim,76,
  193. 'In normal usage, prompts are dim and data fields are bright. Dim data fields');
  194. WritePrompt (1,11,Dim,75,
  195. 'cause the problems shown below. With them you must either show the user the');
  196. WritePrompt (1,12,Dim,78,
  197. 'field limits with some delimiter character (as with field 2) or make her guess');
  198. WritePrompt (1,13,Dim,78,
  199. 'at the field length (as in field 4). Play with these fields to become familiar');
  200. WritePrompt (1,14,Dim,75,
  201. 'with the cursor control keys: Right Arrow, Left Arrow, NewLine (PgDn), Tab,');
  202. WritePrompt (1,15,Dim,39,'and BackTab (Backspace or shifted Tab).');
  203. WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
  204. WritePrompt (4,22,Dim,66,
  205. 'F1: Vertical Screen   F2: Horizontal Screen   F3: Free Form Screen');
  206. WritePrompt (4,23,Dim,14,'Esc: Terminate');
  207. GotoXY (40,17);     (*  Write the         *)
  208. Write (':');        (*  field delimiters  *)
  209. GotoXY (61,17);     (*  for data field 2  *)
  210. Write (':');
  211.  
  212.           (*  Initialize the data fields  *)
  213.  
  214. WriteField (11,17,0,20,'THIS IS FIELD 1');
  215. WriteField (41,17,Dim,20,'THIS IS FIELD 2');
  216. WriteField (11,18,0,20,'THIS IS FIELD 3');
  217. WriteField (41,18,Dim,25,'THIS IS FIELD 4');
  218.  
  219.           (*  Wait for AID key  *)
  220.  
  221. Repeat ReadScreen (1,FK) until FK in [Escape,F1,F2,F3];
  222.  
  223. End;
  224.  
  225.           (*********************)
  226.           (*  Vertical Screen  *)
  227.           (*********************)
  228.  
  229. Procedure VerticalScreen;
  230.  
  231.     Procedure UpStr (Var Str : ScreenLine);
  232.     Var I : Integer;
  233.     Begin
  234.     For I := 1 to Length(Str) do Str[I] := UpCase(Str[I]);
  235.     End;
  236.  
  237. Begin
  238.  
  239.           (*  Set the default colors  *)
  240.  
  241. BrightBG := Blue;
  242. BrightFG := Yellow;
  243. DimBG := Red;
  244. DimFG := White;
  245.  
  246. NewScreen;          (*  Clear the screen and heap  *)
  247.  
  248.           (*  Display all the prompts  *)
  249.  
  250. WritePrompt (15,1,Dim,53,
  251.              'THIS IS AN EXAMPLE OF A VERTICAL SINGLE RECORD SCREEN');
  252. WritePrompt (36,3,Dim,4,'NAME');
  253. WritePrompt (26,4,Dim,14,'ADDRESS LINE 1');
  254. WritePrompt (26,5,Dim,14,'ADDRESS LINE 2');
  255. WritePrompt (36,6,Dim,4,'CITY');
  256. WritePrompt (35,7,Dim,5,'STATE');
  257. WritePrompt (37,8,Dim,3,'ZIP');
  258. WritePrompt (1,10,Dim,79,
  259. 'Vertical format screens are typically used for records that have long fields or');
  260. WritePrompt (1,11,Dim,78,
  261. 'too many fields to fit on one line. Balancing prompts and data fields around a');
  262. WritePrompt (1,12,Dim,78,
  263. 'central vertical line makes for an easy to read, highly productive screen. The');
  264. WritePrompt (1,13,Dim,78,
  265. 'disadvantage of a vertical format is that the operator can only key one record');
  266. WritePrompt (1,14,Dim,76,
  267. 'per screen. This can be counterproductive in a mainframe application, but on');
  268. WritePrompt (1,15,Dim,32,'PC''s it is generally no problem.');
  269. WritePrompt (1,17,Dim,77,
  270. 'Enter some data into this screen and press ENTER. The program will convert it');
  271. WritePrompt (1,18,Dim,76,
  272. 'to upper case and rewrite it, illustrating the RewriteField procedure. These');
  273. WritePrompt (1,19,Dim,76,
  274. 'large fields are also good for practicing the use of Ins, Del, and EraseEOF.');
  275. WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
  276. WritePrompt (4,22,Dim,66,
  277. 'F1: Vertical Screen   F2: Horizontal Screen   F3: Free Form Screen');
  278. WritePrompt (4,23,Dim,14,'Esc: Terminate');
  279.  
  280. With VRcd do
  281.   Begin
  282.  
  283.           (*  Initialize the data fields  *)
  284.  
  285.   WriteField (41,3,0,25,Name);
  286.   WriteField (41,4,0,35,Addr1);
  287.   WriteField (41,5,0,35,Addr2);
  288.   WriteField (41,6,0,20,City);
  289.   WriteField (41,7,0,2,State);
  290.   WriteField (41,8,0,5,ZIP);
  291.  
  292.           (*  Retrieve and rewrite screen fields  *)
  293.  
  294.   Repeat
  295.     ReadScreen (1,FK);
  296.     If FK = Enter Then
  297.       Begin
  298.       GetField (1,Name,Attr);
  299.       UpStr (Name);
  300.       RewriteField (1,Name,0);
  301.       GetField (2,Addr1,Attr);
  302.       UpStr (Addr1);
  303.       RewriteField (2,Addr1,0);
  304.       GetField (3,Addr2,Attr);
  305.       UpStr (Addr2);
  306.       RewriteField (3,Addr2,0);
  307.       GetField (4,City,Attr);
  308.       UpStr (City);
  309.       RewriteField (4,City,0);
  310.       GetField (5,State,Attr);
  311.       UpStr (State);
  312.       RewriteField (5,State,0);
  313.       GetField (6,ZIP,Attr);
  314.       UpStr (ZIP);
  315.       RewriteField (6,ZIP,0);
  316.       End;
  317.   until FK in [Escape,F1,F2,F3];
  318.   End;    (* of With *)
  319. End;      (* of procedure VerticalScreen *)
  320.  
  321.  
  322.           (***********************)
  323.           (*  Horizontal Screen  *)
  324.           (***********************)
  325.  
  326. Procedure HorizontalScreen;
  327.  
  328. Var I : Integer;
  329.  
  330. Begin
  331.  
  332.           (*  Set the default colors  *)
  333.  
  334. BrightBG := Black;
  335. BrightFG := Yellow;
  336. DimBG := Magenta;
  337. DimFG := Yellow;
  338.  
  339. NewScreen;          (*  Clear the screen and heap  *)
  340.  
  341.           (*  Display all the prompts  *)
  342.  
  343. WritePrompt (14,1,Dim,54,
  344.              'THIS IS AN EXAMPLE OF A HORIZONTAL MULTI RECORD SCREEN');
  345. WritePrompt (1,3,Dim,4,'ITEM');
  346. WritePrompt (17,3,Dim,15,'CATALOG   PRICE');
  347. WritePrompt (62,3,Dim,9,'WAREHOUSE');
  348. WritePrompt (1,4,Dim,78,
  349. 'NBR.  QUANTITY  NUMBER    EACH    DESCRIPTION                LOCATION   STATUS');
  350. WritePrompt (1,17,Dim,73,
  351. 'Horizontal format screens are used for entry of multiple identical format');
  352. WritePrompt (1,18,Dim,75,
  353. 'transactions, such as items on an order. The NewLine (PgDn) key is handy on');
  354. WritePrompt (1,19,Dim,76,
  355. 'this type of screen for quickly reaching a specific record. The demo program');
  356. WritePrompt (1,20,Dim,63,
  357. 'does absolutely nothing with the data you enter on this screen.');
  358. WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
  359. WritePrompt (4,22,Dim,66,
  360. 'F1: Vertical Screen   F2: Horizontal Screen   F3: Free Form Screen');
  361. WritePrompt (4,23,Dim,14,'Esc: Terminate');
  362.  
  363.           (*  Initialize the fields  *)
  364.  
  365. For I := 1 to 12 do
  366.   Begin
  367.   GotoXY (2,I+4);
  368.   SetVid (Dim);
  369.   Write (I:2);
  370.   WriteField (9,I+4,0,5,' ');
  371.   WriteField (17,I+4,0,7,' ');
  372.   WriteField (27,I+4,0,6,' ');
  373.   WriteField (35,I+4,0,25,' ');
  374.   WriteField (62,I+4,0,2,' ');
  375.   WriteField (65,I+4,0,3,' ');
  376.   WriteField (69,I+4,0,1,' ');
  377.   WriteField (75,I+4,0,2,' ');
  378.   End;
  379.  
  380.           (*  Do data entry  *)
  381.  
  382. Repeat ReadScreen (1,FK) until FK in [Escape,F1,F2,F3];
  383.  
  384. End;
  385.  
  386.  
  387.           (**********************)
  388.           (*  Free Form Screen  *)
  389.           (**********************)
  390.  
  391. Procedure FreeFormScreen;
  392.  
  393. Type
  394.   WindowLit = Array[1..16] of String[62];
  395.  
  396. Const
  397.   Windo : WindowLit =
  398.       ('╔════════════════════════════════════════════════════════════╗',
  399.        '║ A free form screen is the least desirable format because   ║',
  400.        '║ it usually has a cluttered look. For large records with    ║',
  401.        '║ many fields, however, it is frequently the only choice.    ║',
  402.        '║                                                            ║',
  403.        '║ With this screen the program simulates a file maintenance  ║',
  404.        '║ program. You can add or change records, browse forward or  ║',
  405.        '║ backward, or do indexed file retrieval. See the instruc-   ║',
  406.        '║ tion panel for function key usage. The file isn''t real. It ║',
  407.        '║ is held in RAM and consists of ten records maximum.        ║',
  408.        '║                                                            ║',
  409.        '║ Note that the area code fields are "out of sequence" on    ║',
  410.        '║ the screen and provided with defaults.                     ║',
  411.        '║                                                            ║',
  412.        '║              PRESS ANY KEY TO CONTINUE                     ║',
  413.        '╚════════════════════════════════════════════════════════════╝');
  414.  
  415.  
  416. Var
  417.   Key : String[5];
  418.   I   : Integer;
  419.   At  : Byte;
  420.  
  421. Procedure Prompts;          (*  Display all the prompts  *)
  422. Begin
  423. WritePrompt (21,1,Dim,40,
  424.              'THIS IS AN EXAMPLE OF A FREE FORM SCREEN');
  425. WritePrompt (1,3,Dim,14,'MEMBER #  NAME');
  426. WritePrompt (38,3,Dim,31,'BIRTH DATE  DATE JOINED  STATUS');
  427. WritePrompt (41,4,0,4,'/  /');
  428. WritePrompt (54,4,0,4,'/  /');
  429. WritePrompt (9,6,Dim,28,'PHONE (B) (   )    -     EXT');
  430. WritePrompt (9,7,Dim,20,'PHONE (H) (   )    -');
  431. WritePrompt (11,8,Dim,8,'ADDRESS');
  432. WritePrompt (39,10,Dim,1,',');
  433. WritePrompt (17,12,Dim,48,'╔══════════════════════════════════════════════╗');
  434. WritePrompt (17,13,Dim,48,'║ Alt-F1: Add Record   Alt-F2: Change Record   ║');
  435. WritePrompt (17,14,Dim,48,'║ Alt-F3: Next Record  Alt-F4: Previous Record ║');
  436. WritePrompt (17,15,Dim,48,'║ Alt-F5: Find Member  Alt-F10: HELP           ║');
  437. WritePrompt (17,16,Dim,48,'╚══════════════════════════════════════════════╝');
  438. WritePrompt (1,21,Dim,37,'When you are ready to move on, press:');
  439. WritePrompt (4,22,Dim,66,
  440. 'F1: Vertical Screen   F2: Horizontal Screen   F3: Free Form Screen');
  441. WritePrompt (4,23,Dim,14,'Esc: Terminate');
  442. End;
  443.  
  444. Procedure RetrieveRcd;   (*  Get all the fields from the screen  *)
  445. Begin
  446. With FRcd[Mem] do
  447.   Begin
  448.   GetField (1,Memb,Attr);
  449.   GetField (2,Name,Attr);
  450.   GetField (3,BDM,Attr);
  451.   GetField (4,BDD,Attr);
  452.   GetField (5,BDY,Attr);
  453.   GetField (6,DJM,Attr);
  454.   GetField (7,DJD,Attr);
  455.   GetField (8,DJY,Attr);
  456.   GetField (9,Stat,Attr);
  457.   GetField (10,BPEX,Attr);
  458.   GetField (11,BPNU,Attr);
  459.   GetField (12,BPX,Attr);
  460.   GetField (13,HPEX,Attr);
  461.   GetField (14,HPNU,Attr);
  462.   GetField (15,Addr1,Attr);
  463.   GetField (16,Addr2,Attr);
  464.   GetField (17,City,Attr);
  465.   GetField (18,State,Attr);
  466.   GetField (19,ZIP,Attr);
  467.   GetField (20,BPAC,Attr);
  468.   GetField (21,HPAC,Attr);
  469.   End;
  470. End;
  471.  
  472. Procedure DisplayRcd;
  473. Begin
  474. With FRcd[Mem] do
  475.   Begin
  476.   RewriteField (1,Memb,0);
  477.   RewriteField (2,Name,0);
  478.   RewriteField (3,BDM,0);
  479.   RewriteField (4,BDD,0);
  480.   RewriteField (5,BDY,0);
  481.   RewriteField (6,DJM,0);
  482.   RewriteField (7,DJD,0);
  483.   RewriteField (8,DJY,0);
  484.   RewriteField (9,Stat,0);
  485.   RewriteField (10,BPEX,0);
  486.   RewriteField (11,BPNU,0);
  487.   RewriteField (12,BPX,0);
  488.   RewriteField (13,HPEX,0);
  489.   RewriteField (14,HPNU,0);
  490.   RewriteField (15,Addr1,0);
  491.   RewriteField (16,Addr2,0);
  492.   RewriteField (17,City,0);
  493.   RewriteField (18,State,0);
  494.   RewriteField (19,ZIP,0);
  495.   RewriteField (20,BPAC,0);
  496.   RewriteField (21,HPAC,0);
  497.   End;
  498. End;
  499.  
  500.  
  501. Begin
  502.           (*  Set the default colors  *)
  503.  
  504. BrightBG := Magenta;
  505. BrightFG := Yellow;
  506. DimBG := Cyan;
  507. DimFG := Yellow;
  508.  
  509. NewScreen;          (*  Clear the screen and heap  *)
  510.  
  511. Prompts;
  512.  
  513.           (*  Initialize the data fields  *)
  514.  
  515. With FRcd[Mem] do
  516.   Begin
  517.   WriteField (2,4,0,5,Memb);
  518.   WriteField (11,4,0,25,Name);
  519.   WriteField (39,4,0,2,BDM);
  520.   WriteField (42,4,0,2,BDD);
  521.   WriteField (45,4,0,2,BDY);
  522.   WriteField (52,4,0,2,DJM);
  523.   WriteField (55,4,0,2,DJD);
  524.   WriteField (58,4,0,2,DJY);
  525.   WriteField (65,4,0,1,Stat);
  526.   WriteField (25,6,0,3,BPEX);
  527.   WriteField (29,6,0,4,BPNU);
  528.   WriteField (38,6,0,4,BPX);
  529.   WriteField (25,7,0,3,HPEX);
  530.   WriteField (29,7,0,4,HPNU);
  531.   WriteField (19,8,0,35,Addr1);
  532.   WriteField (19,9,0,35,Addr2);
  533.   WriteField (19,10,0,20,City);
  534.   WriteField (41,10,0,2,State);
  535.   WriteField (45,10,0,5,ZIP);
  536.   WriteField (20,6,0,3,BPAC);
  537.   WriteField (20,7,0,3,HPAC);
  538.   End;
  539.  
  540. Repeat
  541.   ReadScreen (1,FK);
  542.   Case FK of
  543.     F11 : If LastM >= 10 Then
  544.             Begin
  545.             GotoXY (1,25);
  546.             LowVid(0);
  547.             Write ('File full - cannot add');
  548.             End
  549.           Else
  550.             Begin
  551.             GetField (1,Key,Attr);
  552.             If Key = '     ' Then
  553.               Begin
  554.               GotoXY (1,25);
  555.               LowVid(0);
  556.               Write ('Invalid key - cannot add');
  557.               ClrEol;
  558.               End
  559.             Else
  560.               Begin
  561.               I := 1;
  562.               While (I <= LastM) and (Key <> FRcd[I].Memb) do I := I + 1;
  563.               If I<= LastM Then
  564.                 Begin
  565.                 GotoXY (1,25);
  566.                 Write ('Duplicate key - cannot add');
  567.                 ClrEol;
  568.                 End
  569.               Else
  570.                 Begin
  571.                 LastM := LastM + 1;
  572.                 Mem := LastM;
  573.                 RetrieveRcd;
  574.                 GotoXY (1,25);
  575.                 LowVid(0);
  576.                 Write ('Record Added');
  577.                 ClrEol;
  578.                 End;
  579.               End;
  580.             End;
  581.  
  582.     F12 : Begin
  583.           GetField (1,Key,Attr);
  584.           If Key = '     ' Then
  585.             Begin
  586.             GotoXY (1,25);
  587.             LowVid(0);
  588.             Write ('Invalid Key - cannot change');
  589.             ClrEol;
  590.             End
  591.           Else
  592.             Begin
  593.             I := 1;
  594.             While (I <= LastM) and (FRcd[I].Memb <> Key) do I := I + 1;
  595.             If (I <= LastM) and (I <> Mem) Then
  596.               Begin
  597.               GotoXY (1,25);
  598.               LowVid(0);
  599.               Write ('Duplicate Key - Cannot change');
  600.               ClrEol;
  601.               End
  602.             Else
  603.               Begin
  604.               RetrieveRcd;
  605.               GotoXY (1,25);
  606.               LowVid(0);
  607.               Write ('Record');
  608.               If Key <> FRcd[Mem].Memb then Write (' and Key');
  609.               Write (' Changed');
  610.               ClrEol;
  611.               End;
  612.             End;
  613.           End;
  614.  
  615.     F13 : If Mem >= LastM Then
  616.             Begin
  617.             GotoXY (1,25);
  618.             LowVid(0);
  619.             Write ('End of File');
  620.             ClrEol;
  621.             End
  622.           Else
  623.             Begin
  624.             Mem := Mem + 1;
  625.             DisplayRcd;
  626.             GotoXY (1,25);
  627.             LowVid(0);
  628.             ClrEol;
  629.             End;
  630.  
  631.     F14 : If Mem <= 1 Then
  632.             Begin
  633.             GotoXY (1,25);
  634.             LowVid(0);
  635.             Write ('Beginning of File');
  636.             ClrEol;
  637.             End
  638.           Else
  639.             Begin
  640.             Mem := Mem - 1;
  641.             DisplayRcd;
  642.             GotoXY (1,25);
  643.             LowVid(0);
  644.             ClrEol;
  645.             End;
  646.  
  647.     F15 : Begin
  648.           GetField (1,Key,Attr);
  649.           I := 1;
  650.           While (I <= LastM) and (Key <> FRcd[I].Memb) do I := I + 1;
  651.           If I > LastM Then
  652.             Begin
  653.             GotoXY (1,25);
  654.             LowVid(0);
  655.             Write ('Not in File');
  656.             ClrEol;
  657.             End
  658.           Else
  659.             Begin
  660.             Mem := I;
  661.             DisplayRcd;
  662.             GotoXY (1,25);
  663.             LowVid(0);
  664.             ClrEol;
  665.             End;
  666.           End;
  667.  
  668.     F20 : Begin
  669.           BrightBG := Blue;
  670.           At := White;
  671.           ConvAttr (At, Attr);
  672.           For I := 1 to 16 do PutLine (10,I+5,Attr,Windo[I]);
  673.           Repeat until KeyPressed;
  674.           BrightBG := Magenta;
  675.           ClrScr;
  676.           Prompts;
  677.           DisplayRcd;
  678.           End;
  679.     End;
  680.  
  681. Until FK in [Escape,F1,F2,F3];
  682. End;
  683.  
  684.                     (*******************************)
  685.                     (*  MAINLINE CODE BEGINS HERE  *)
  686.                     (*******************************)
  687.  
  688. Begin
  689.  
  690. InitScreen;         (*  <--- ABSOLUTELY NECESSARY!!!   *)
  691.  
  692. WelcomeScreen;
  693. If FK = Escape then Halt;
  694.  
  695. Screen2;
  696.  
  697. With VRcd do
  698.   Begin
  699.   Name := Spaces;
  700.   Addr1 := Spaces;
  701.   Addr2 := Spaces;
  702.   City := Spaces;
  703.   State := Spaces;
  704.   ZIP := Spaces;
  705.   End;
  706.  
  707. Mem := 1;
  708. LastM := 0;
  709. With FRcd[Mem] do
  710.   Begin
  711.   Memb := Spaces;
  712.   Name := Spaces;
  713.   BDM := Spaces;
  714.   BDD := Spaces;
  715.   BDY := Spaces;
  716.   DJM := Spaces;
  717.   DJD := Spaces;
  718.   DJY := Spaces;
  719.   Stat := Spaces;
  720.   BPAC := '101';
  721.   BPEX := Spaces;
  722.   BPNU := Spaces;
  723.   BPX := Spaces;
  724.   HPAC := '101';
  725.   HPEX := Spaces;
  726.   HPNU := Spaces;
  727.   Addr1 := Spaces;
  728.   Addr2 := Spaces;
  729.   City := Spaces;
  730.   State := Spaces;
  731.   ZIP := Spaces;
  732.   End;
  733.  
  734. While Not (FK = Escape) do
  735. Case FK of
  736.   F1 : VerticalScreen;
  737.   F2 : HorizontalScreen;
  738.   F3 : FreeFormScreen;
  739.   End;
  740.  
  741. End.